home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE05 / CONSTRUC / LISTBOB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-14  |  1.9 KB  |  76 lines
  1. unit ListBob;
  2. interface
  3. uses
  4.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  5.   Forms, Dialogs, StdCtrls;
  6.  
  7. type
  8.   TChangeEvent = procedure(Sender: TObject; PrevItemIndex: Integer) of Object;
  9.  
  10.   TListBob = class(TListBox)
  11.   private
  12.     { Private declarations }
  13.     FPrevItemIndex: Integer;
  14.     FOnChange: TChangeEvent;
  15.  
  16.   protected
  17.     { Protected declarations }
  18.     procedure Click; override;
  19.     procedure WMSetCurSel(var Message: TMessage); message LB_SETCURSEL;
  20.  
  21.   public
  22.     { Public declarations }
  23.     constructor Create(AOwner: TComponent); override;
  24.  
  25.     procedure CreateParams(var Params: TCreateParams); override;
  26.     Procedure SetTabStops(Val: Array of Word);
  27.  
  28.   published
  29.     { Published declarations }
  30.     property OnChange: TChangeEvent read FOnChange write FOnChange;
  31.   end {TListBob};
  32.  
  33. procedure Register;
  34.  
  35. implementation
  36.  
  37. constructor TListBob.Create(AOwner: TComponent);
  38. begin
  39.   inherited Create(AOwner);
  40.   FPrevItemIndex := -1 { default: no selection }
  41. end {Create};
  42.  
  43. procedure TListBob.CreateParams(var Params: TCreateParams);
  44. begin
  45.   inherited CreateParams(Params);
  46.   with Params do Style := Style or LBS_USETABSTOPS
  47. end {CreateParams};
  48.  
  49. procedure TListBob.SetTabStops(Val: Array of Word);
  50. begin
  51.   SendMessage(Handle, LB_SETTABSTOPS, High(Val)-Low(Val)+1, LongInt(@Val))
  52. end {SetTabStops};
  53.  
  54. procedure TListBob.Click;
  55. begin
  56.   inherited Click;
  57.   if FPrevItemIndex <> ItemIndex then
  58.     if Assigned(FOnChange) then FOnChange(Self, FPrevItemIndex);
  59.   FPrevItemIndex := ItemIndex
  60. end {Click};
  61.  
  62. procedure TListBob.WMSetCurSel(var Message: TMessage);
  63. { if someone assigns a new value to ItemIndex }
  64. begin
  65.   DefaultHandler(Message);
  66.   if Assigned(FOnChange) then FOnChange(Self, FPrevItemIndex);
  67.   FPrevItemIndex := ItemIndex
  68. end {WmSetCurSel};
  69.  
  70. procedure Register;
  71. begin
  72.   RegisterComponents('Dr.Bob', [TListBob])
  73. end;
  74.  
  75. end.
  76.